home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / guile-ii.src / guile-ii / guile-src / slib / macrotst.scm < prev    next >
Encoding:
Text File  |  1994-07-11  |  1.2 KB  |  55 lines
  1. ;;;"macrotst.scm" Test for R4RS Macros
  2. ;;; From Revised^4 Report on the Algorithmic Language Scheme
  3. ;;; Editors: William Clinger and Jonathon Rees
  4. ;
  5. ; We intend this report to belong to the entire Scheme community, and so
  6. ; we grant permission to copy it in whole or in part without fee.  In
  7. ; particular, we encourage implementors of Scheme to use this report as
  8. ; a starting point for manuals and other documentation, modifying it as
  9. ; necessary.
  10.  
  11. ;;; To run this code type
  12. ;;; (require 'macro)
  13. ;;; (macro:load "macrotst.scm")
  14.  
  15. (write "this code should print now, outer, and 7") (newline)
  16.  
  17. (write
  18.  (let-syntax ((when (syntax-rules ()
  19.                   ((when test stmt1 stmt2 ...)
  20.                    (if test
  21.                        (begin stmt1
  22.                           stmt2 ...))))))
  23.    (let ((if #t))
  24.      (when if (set! if 'now))
  25.      if)))
  26. (newline)
  27. ;;;            ==> now
  28.  
  29. (write
  30.  (let ((x 'outer))
  31.    (let-syntax ((m (syntax-rules () ((m) x))))
  32.      (let ((x 'inner))
  33.        (m)))))
  34. (newline)
  35. ;;;            ==> outer
  36. (write
  37.  (letrec-syntax
  38.   ((or (syntax-rules ()
  39.      ((or) #f)
  40.      ((or e) e)
  41.      ((or e1 e2 ...)
  42.       (let ((temp e1))
  43.         (if temp temp (or e2 ...)))))))
  44.   (let ((x #f)
  45.     (y 7)
  46.     (temp 8)
  47.     (let odd?)
  48.     (if even?))
  49.     (or x
  50.     (let temp)
  51.     (if y)
  52.     y))))
  53. (newline)
  54. ;;;            ==> 7
  55.